home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD2001.psc / My Projects / HTTPServer / V2.0 / HTTPServiceRequest.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-11-07  |  3.9 KB  |  175 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "HTTPServiceRequest"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Option Explicit
  17.  
  18. Private WithEvents mSock As SocketConnection
  19. Attribute mSock.VB_VarHelpID = -1
  20. Private mParent As HTTPServer
  21. Private mstrData As String
  22.  
  23. Public Method As String
  24. Public URI As String
  25. Public HTTPVersion As String
  26. Public Headers As HTTPHeaderList
  27. Public Parameters As HTTPParameterList
  28. Public Index As Long
  29.  
  30. Const GET_DELIMITER = "?"
  31. Const HEADER_DELIMITER = vbNewLine & vbNewLine
  32. Friend Function Initialize(Conn As SocketConnection, Parent As HTTPServer) As Boolean
  33.  
  34.   Set mSock = Conn
  35.   Set mParent = Parent
  36.   
  37.   Initialize = (Not (Conn Is Nothing)) And (Not (mParent Is Nothing))
  38.  
  39. End Function
  40.  
  41.  
  42. Private Function ParseElements(ByVal Data As String) As Boolean
  43.  
  44.   Dim FirstLine As String
  45.   Dim URITemp As String
  46.   Dim HeaderTemp As String
  47.   
  48.   If (Right(Data, 2) <> (vbCr & vbCr)) And (Right(Data, 2) <> vbNewLine) Then
  49.     Exit Function
  50.   End If
  51.   
  52.   Set Parameters = New HTTPParameterList
  53.   Set Headers = New HTTPHeaderList
  54.  
  55.   FirstLine = SplitFrom(Data, vbCr)
  56.   
  57.   Method = Trim(SplitFrom(FirstLine, " "))
  58.   URITemp = Trim(SplitFrom(FirstLine, " "))
  59.   HTTPVersion = Trim(FirstLine)
  60.   
  61.   URI = SplitFrom(URITemp, GET_DELIMITER)
  62.  
  63.   If Len(URITemp) Then
  64.     ' Process GET commands
  65.     Parameters.AddItems URITemp
  66.   End If
  67.   
  68.   HeaderTemp = SplitFrom(Data, vbCr & vbCr)
  69.   If Len(HeaderTemp) Then
  70.     Headers.AddItems HeaderTemp
  71.   Else
  72.     Headers.AddItems Data
  73.     Data = ""
  74.   End If
  75.   
  76.   If Len(Data) Then
  77.     Parameters.AddItems Data
  78.   End If
  79.   
  80.   ParseElements = True
  81.  
  82. End Function
  83.  
  84.  
  85. Public Property Get RawRequest() As String
  86.  
  87.   RawRequest = mstrData
  88.  
  89. End Property
  90.  
  91. Private Sub SendDebugResponse(Optional Data As String = "")
  92.  
  93.   Dim sTemp As String
  94.   Dim sContent As String
  95.   
  96.   If Data = "" Then
  97.     sContent = "<HTML><BODY>Here's where the response would be</BODY></HTML>"
  98.   Else
  99.     sContent = Data
  100.   End If
  101.     
  102.   sTemp = "HTTP/1.0 200 OK" & vbNewLine
  103.   sTemp = sTemp & "Content-type: text/html" & vbNewLine
  104.   sTemp = sTemp & "Content-length: " & Len(sContent) & vbNewLine
  105.   sTemp = sTemp & vbNewLine
  106.   
  107.   sTemp = sTemp & sContent
  108.  
  109.   mSock.SendData sTemp
  110.  
  111. End Sub
  112.  
  113. Private Sub SendSocketClose()
  114.  
  115.   On Error Resume Next
  116.   DoEvents
  117.   mSock.SendData Chr(0)
  118.   mSock.SendData Chr(0)
  119.   mSock.SendData Chr(0)
  120.  
  121. End Sub
  122.  
  123. Friend Property Get Socket() As SocketConnection
  124.  
  125.   Set Socket = mSock
  126.  
  127. End Property
  128.  
  129. Public Sub WriteResponse(ResponseCode As String, HeaderData As DelimitedString, Data As String)
  130.  
  131.   Dim RetString As String
  132.   
  133.   RetString = Me.HTTPVersion & " " & ResponseCode & vbCrLf & HeaderData.Value & vbCrLf & vbCrLf & Data & vbCrLf & vbCrLf
  134.  
  135.   mSock.SendData RetString
  136.   Set mSock = Nothing
  137.  
  138. End Sub
  139.  
  140. Private Sub Class_Terminate()
  141.   
  142.   Set mSock = Nothing
  143.   Set Parameters = Nothing
  144.  
  145. End Sub
  146.  
  147.  
  148. Private Sub mSock_ConnectionClosed()
  149.  
  150.   On Error Resume Next
  151.   Set mSock = Nothing
  152.   mParent.Dispose Me.Index
  153.   Set mParent = Nothing
  154.  
  155. End Sub
  156.  
  157.  
  158. Private Sub mSock_DataReceived(Data As Variant, Count As Long)
  159.  
  160.   mstrData = mstrData & Data
  161.  
  162.   If ParseElements(mstrData) Then
  163.     mParent.GetResponse Me
  164.     mstrData = ""
  165.   End If
  166.  
  167. End Sub
  168. Private Sub mSock_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  169.  
  170.   WriteStatus "Error: " & Number & ", " & Description
  171.   Call mSock_ConnectionClosed
  172.  
  173. End Sub
  174.  
  175.